home *** CD-ROM | disk | FTP | other *** search
/ 8bitfiles.net/archives / archives.tar / archives / commodore-users-of-norman / CUON_07_(08-1984).d64 / sprite editor (.txt) < prev    next >
Commodore BASIC  |  2019-04-13  |  11KB  |  312 lines
  1. 86 REM *************************************
  2. 87 REM *                                   *
  3. 88 REM *            CREATED FOR            *
  4. 89 REM *                                   *
  5. 90 REM *  THE COMMODORE EDUCATIONAL GROUP  *
  6. 91 REM *                                   *
  7. 92 REM *                BY                 *
  8. 93 REM *                                   *
  9. 94 REM *         GARRY G. KIZIAK           *
  10. 95 REM *                                   *
  11. 96 REM *         COPYRIGHT  1982           *
  12. 97 REM *                                   *
  13. 98 REM *************************************
  14. 99 :
  15. 100 PRINT"[147]";
  16. 110 DEF FNX(X)=X-INT(X/24)*24
  17. 120 DEF FNY(X)=X-INT(X/21)*21
  18. 130 V$=""
  19. 140 DOT$="........................":BL$="                                       "
  20. 150 G=13*4096:CR$=CHR$(13):DE$=CHR$(20):C=1:B=6:E=14:SX=30:SY=150:X1=0:Y1=0
  21. 160 PA=200:SP=0:SC=1024+80+3:AD=32608
  22. 170 GOSUB 960
  23. 180 GOSUB 870
  24. 190 GOSUB 930
  25. 200 GOSUB 850
  26. 210 PX=0:PY=0
  27. 220 P=SC+PY*40+PX:Q=PEEK(P):R=Q
  28. 230 R=(NOTRAND128)OR(NOT128ANDR)
  29. 240 POKE P,R
  30. 250 FOR I=1 TO 30:GET A$:IF A$="" THEN NEXT:GOTO 230
  31. 260 POKE P,Q
  32. 270 IF A$="" THEN PX=FNX(PX+1):GOTO 220
  33. 280 IF A$="[157]" THEN PX=FNX(PX-1):GOTO 220
  34. 290 IF A$="" THEN PY=FNY(PY+1):GOTO 220
  35. 300 IF A$="[145]" THEN PY=FNY(PY-1):GOTO 220
  36. 310 IF A$=DE$ THEN POKE P,PEEK(P) AND 127:GOTO 680
  37. 320 IF A$=" " THEN GOSUB 660:PX=FNX(PX+1):GOTO 220
  38. 330 IF A$=CR$ THEN PX=0:PY=FNY(PY+1):GOTO 220
  39. 340 IF A$="." THEN 740
  40. 350 IF A$="[147]" THEN GOSUB 820:GOTO 210
  41. 360 IF A$="" THEN GOSUB 830:GOTO 210
  42. 370 IF A$="+" THEN 780
  43. 380 IF A$="-" THEN 800
  44. 390 IF A$="Q" THEN POKE G+21,0:PRINT "[147]";:END
  45. 400 IF A$=">" THEN C=(C+1)AND15:POKE G+39,C
  46. 410 IF A$="" THEN B=(B+1)AND15:POKE 53281,B
  47. 420 IF A$="" THEN E=(E+1)AND15:POKE 53280,E
  48. 430 IF A$="" THEN X1=1-X1:GOSUB 900:GOSUB 870:GOTO 220
  49. 440 IF A$="" THEN Y1=1-Y1:GOSUB 900:GOSUB 870:GOTO 220
  50. 450 IF A$="[133]" THEN 580
  51. 460 IF A$="[134]" THEN 600
  52. 470 IF A$="[135]" THEN 620
  53. 480 IF A$="[136]" THEN 640
  54. 490 IF A$="" THEN 1510
  55. 500 IF A$="S" THEN 1270
  56. 510 IF A$="" THEN 1030
  57. 520 IF A$="" THEN 1070
  58. 530 IF A$=" " THEN 1430
  59. 540 IF A$="" THEN 210
  60. 550 IF A$="" THEN GOSUB 1860:GOTO 170
  61. 555 IF A$="\" THEN 690
  62. 556 IF A$="M" THEN POKE G+28,1
  63. 557 IF A$="H" THEN POKE G+28,0
  64. 560 GOTO 220
  65. 570 POKE G+21,0:GOSUB 930:GOSUB 870:GOSUB 850:GOTO 210
  66. 574 REM ****************************
  67. 575 REM *                          *
  68. 576 REM *  MOVE ENTIRE SPRITE UP,  *
  69. 577 REM *   DOWN, LEFT, OR RIGHT   *
  70. 578 REM *                          *
  71. 579 REM ****************************
  72. 580 J=PA*64:POKE 253,J-256*INT(J/256):POKE 254,J/256
  73. 590 SYS AD:GOSUB 850:GOTO220
  74. 600 J=PA*64+59:POKE 253,J-256*INT(J/256):POKE 254,J/256
  75. 610 SYS AD+42:GOSUB 850:GOTO220
  76. 620 J=PA*64:POKE 253,J-256*INT(J/256):POKE 254,J/256
  77. 630 SYS AD+88:GOSUB 850:GOTO220
  78. 640 J=PA*64:POKE 253,J-256*INT(J/256):POKE 254,J/256
  79. 650 SYS AD+118:GOSUB 850:GOTO220
  80. 655 REM ****************************
  81. 656 REM *                          *
  82. 657 REM * ERASE OR DELETE A POINT  *
  83. 658 REM *                          *
  84. 659 REM ****************************
  85. 660 POKE P,46:PP=PA*64+PY*3+INT(PX/8)
  86. 670 POKE PP,PEEK(PP) AND 255-2^(7-(PX-INT(PX/8)*8)):RETURN
  87. 680 PX=FNX(PX-1):P=SC+PY*40+PX:GOSUB 660:GOTO 220
  88. 685 REM ****************************
  89. 686 REM *                          *
  90. 687 REM * ROTATE SPRITE 90 DEGREES *
  91. 688 REM *                          *
  92. 689 REM ****************************
  93. 690 HI=INT(PA/4):LO=PA*64-256*HI:POKE 251,LO:POKE 252,HI:SYS 32422
  94. 700 SYS 32443:SYS 32526:POKE 251,LO:POKE 252,HI
  95. 710 GET A$:IF A$<>"\" AND A$<>CR$ THEN 710
  96. 720 IF A$="\" THEN 700
  97. 730 GOTO 220
  98. 735 REM ****************************
  99. 736 REM *                          *
  100. 737 REM *       PLOT A POINT       *
  101. 738 REM *                          *
  102. 739 REM ****************************
  103. 740 POKE P,81
  104. 750 PP=PA*64+PY*3+INT(PX/8)
  105. 760 POKE PP,PEEK(PP) OR 2^(7-(PX-INT(PX/8)*8))
  106. 770 PX=FNX(PX+1):GOTO 220
  107. 775 REM ****************************
  108. 776 REM *                          *
  109. 777 REM * NEXT OR PREVIOUS SPRITE  *
  110. 778 REM *                          *
  111. 779 REM ****************************
  112. 780 IF PA<15 OR (PA>31ANDPA<63) OR(PA>127ANDPA<255) THEN PA=PA+1:GOTO570
  113. 790 GOTO 220
  114. 800 IF(PA>13ANDPA<16) OR (PA>32ANDPA<64) OR(PA>128ANDPA<256) THEN PA=PA-1:GOTO570
  115. 810 GOTO 220
  116. 815 REM ****************************
  117. 816 REM *                          *
  118. 817 REM *       CLEAR SPRITE       *
  119. 818 REM *                          *
  120. 819 REM ****************************
  121. 820 FOR X=0 TO 63:POKE PA*64+X,0:NEXT:GOSUB 850:RETURN
  122. 825 REM ****************************
  123. 826 REM *                          *
  124. 827 REM *      REVERSE SPRITE      *
  125. 828 REM *                          *
  126. 829 REM ****************************
  127. 830 FOR X=0 TO 63:Y=PEEK(PA*64+X):Y=(NOTYAND255) OR (NOT255ANDY):POKE PA*64+X,Y
  128. 840 NEXT:GOSUB 850:RETURN
  129. 845 REM ****************************
  130. 846 REM *                          *
  131. 847 REM * DISPLAY SPRITE ON SCREEN *
  132. 848 REM *                          *
  133. 849 REM ****************************
  134. 850 POKE 251,PA*64-INT(PA/4)*256:POKE 252,PA/4
  135. 860 SYS 32526:PRINT"":RETURN
  136. 865 REM ****************************
  137. 866 REM *                          *
  138. 867 REM *  INITIALIZE SPRITE DATA  *
  139. 868 REM *                          *
  140. 869 REM ****************************
  141. 870 POKE G+21,0:POKE 2040+SP,PA:POKE G+39,C
  142. 880 POKE G+SP*2,SX:POKE G+SP*2+1,SY:POKE G+23,Y1:POKE G+29,X1
  143. 890 POKE G+16,2^SP:POKE G+21,2^SP:RETURN
  144. 895 REM ****************************
  145. 896 REM *                          *
  146. 897 REM *  EXPAND/CONTRACT SPRITE  *
  147. 898 REM *                          *
  148. 899 REM ****************************
  149. 900 SX=17:IF X1=0 THEN SX=30
  150. 910 SY=138:IF Y1=0 THEN SY=150
  151. 920 RETURN
  152. 925 REM ****************************
  153. 926 REM *                          *
  154. 927 REM *  DISPLAY EDITING SCREEN  *
  155. 928 REM *                          *
  156. 929 REM ****************************
  157. 930 PRINT ""TAB(29)"[180]        [167]":PRINT TAB(29)"[180]PAGE    [167]"
  158. 940 PRINT TAB(29)"[204][175][175][175][175][175][175][175][175][186]":PRINT "[145][145]"TAB(34)PA
  159. 950 RETURN
  160. 960 PRINT " [164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164] [175][175][175][175][175][175][175][175][175][175]"
  161. 970 PRINT "   123456789012345678901234 [146]   SPRITE  [157][157][157][157][157][157][157][157][157][157]  EDITOR  "
  162. 980 FOR X=1 TO 21
  163. 990 PRINT " "RIGHT$(" "+STR$(X),2)"[146]"DOT$" [146]":NEXT
  164. 1000 PRINT "                            [146]"
  165. 1010 RETURN
  166. 1015 REM ****************************
  167. 1016 REM *                          *
  168. 1017 REM *    PROMPT FOR NEW PAGE   *
  169. 1018 REM *                          *
  170. 1019 REM ****************************
  171. 1020 IF IN$="" THEN PA=AP:GOTO 180
  172. 1030 LI=18:COL=30:LE=3:MSG$="[146]PAGE[146]":GOSUB 1700:AP=PA:PA=VAL(IN$)
  173. 1040 PRINTLEFT$(V$,LI)TAB(COL-1)"         "
  174. 1050 IF IN$="" OR PA<13 OR (PA>15ANDPA<32)OR (PA>63ANDPA<128) OR PA>255 THEN PA=AP
  175. 1060 GOTO 180
  176. 1065 REM ****************************
  177. 1066 REM *                          *
  178. 1067 REM * DISPLAY RANGE OF SPRITES *
  179. 1068 REM *                          *
  180. 1069 REM ****************************
  181. 1070 POKE G+21,0:POKE G+16,0:POKE G+23,0:POKE G+29,0:GOSUB 1250
  182. 1080 LI=8:COL=6:LE=3:MSG$="[146]FROM PAGE:[146]"
  183. 1090 GOSUB 1700:GP=PG:PG=VAL(IN$):IFIN$="" THEN PRINT "[147]":GOTO 170
  184. 1100 IF PG<0 OR PG>255 OR (PG=0 AND IN$<>"0") THEN 1080
  185. 1110 LI=8:COL=22:MSG$="[146]TO PAGE:[146]"
  186. 1120 GOSUB 1700:PH=VAL(IN$):IF PH<PG OR PH>255 THEN 1110
  187. 1130 SW=PG
  188. 1140 SUM=0:EN=SW+7:IF EN>PH THEN EN=PH:IF SW>PH THEN 170
  189. 1150 GOSUB 1250:FOR I=SW TO EN:K=I-SW:M=K:IF M>3 THEN M=M-4
  190. 1160 POKE 2040+K,I:SUM=SUM+2^K
  191. 1170 POKE G+K*2,M*48+104:L=98:L1=10:IF K>3 THEN L=155:L1=17
  192. 1180 POKE G+K*2+1,L:POKE G+39+K,1:POKE G+21,SUM
  193. 1190 PRINT LEFT$(V$,L1)TAB(M*6+9)I
  194. 1200 NEXT
  195. 1210 PRINTLEFT$(V$,20)TAB(7)"      [164][164][164][164][164][164][164][164][164]"
  196. 1220 PRINTTAB(7)"PRESS SPACE BAR[146] TO CONTINUE"
  197. 1230 GET A$:IF A$<>" "THEN 1230
  198. 1240 POKE G+21,0:PRINT "[147]":SW=EN+1:GOTO 1140
  199. 1250 PRINT "[147]            [164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164]"
  200. 1260 PRINT "             DISPLAY SPRITES [146]":RETURN
  201. 1265 REM ****************************
  202. 1266 REM *                          *
  203. 1267 REM *   SAVE SPRITES TO DISK   *
  204. 1268 REM *                          *
  205. 1269 REM ****************************
  206. 1270 POKE G+21,0:PRINT "[147]           [164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164]"
  207. 1280 PRINT "            SAVE SPRITE DATA [146]"
  208. 1290 LI=8:COL=6:LE=3:MSG$="[146]FROM PAGE:[146]"
  209. 1300 GOSUB 1700:PG=VAL(IN$):IF IN$="" THEN PRINT "[147]":GOTO 170
  210. 1310 IF PG<13 OR (PG>15 AND PG<32) OR (PG>63 AND PG<128) OR PG>255 THEN 1290
  211. 1320 LI=8:COL=22:MSG$="[146]TO PAGE:[146]":GOSUB 1700:PH=VAL(IN$)
  212. 1330 IF PH<PG OR (PH>15 AND PH<32) OR (PH>63 AND PH<128) OR PH>255 THEN 1320
  213. 1340 BEG=PG*64:EN=PH*64+64:HI=INT(BEG/256):LO=BEG-HI*256
  214. 1350 LI=10:COL=12:LE=16:MSG$="[146]FILENAME:[146]":GOSUB 1700:FL$="0:"+IN$+",PRG,WRITE"
  215. 1360 OPEN 1,8,15,"I0":GOSUB 1810
  216. 1370 OPEN 2,8,1,FL$:GOSUB 1810
  217. 1380 PRINT#2,CHR$(LO);CHR$(HI);
  218. 1390 Y=2:FOR I=BEG TO EN:X=PEEK(I):PRINT#2,CHR$(X);:GOSUB 1810
  219. 1400 PRINT LEFT$(V$,12)TAB(12)MID$(""+"WRITING"+"[146]: ",Y)IN$:Y=3-Y:NEXT
  220. 1410 CLOSE 2:CLOSE 1
  221. 1420 PRINT "[147]":GOTO 170
  222. 1425 REM ****************************
  223. 1426 REM *                          *
  224. 1427 REM *  LOAD SPRITES FROM DISK  *
  225. 1428 REM *                          *
  226. 1429 REM ****************************
  227. 1430 POKE G+21,0:PRINT "[147]           [164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164]"
  228. 1440 PRINT "            LOAD SPRITE DATA [146]"
  229. 1450 LI=10:COL=12:LE=16:MSG$="[146]FILENAME:[146]":GOSUB 1700:FL$="0:"+IN$
  230. 1460 IF IN$="" THEN PRINT "[147]":GOTO 170
  231. 1470 OPEN1,8,15,"I0"
  232. 1480 OPEN2,8,0,FL$:GOSUB 1810:CLOSE 2:CLOSE 1
  233. 1490 LOAD FL$,8,1
  234. 1500 END
  235. 1504 REM ****************************
  236. 1505 REM *                          *
  237. 1506 REM *  COPY SPRITES TO ANOTHER *
  238. 1507 REM *      AREA IN MEMORY      *
  239. 1508 REM *                          *
  240. 1509 REM ****************************
  241. 1510 POKE G+21,0:PRINT "[147]           [164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164]"
  242. 1520 PRINT "            COPY SPRITE DATA [146]"
  243. 1530 PRINT LEFT$(V$,4)" [164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164]":PRINT " ** SOURCE PAGES **"
  244. 1540 LI=7:COL=4:LE=3:MSG$="[146]FROM PAGE:[146]"
  245. 1550 GOSUB 1700:PG=VAL(IN$):IF IN$="" THEN PRINT "[147]":GOTO 170
  246. 1560 IF PG<13 OR (PG>15 AND PG<32) OR (PG>63 AND PG<128) OR PG>255 THEN 1540
  247. 1570 LI=9:COL=4:LE=3:MSG$="[146]..TO PAGE:[146]":GOSUB 1700:PH=VAL(IN$)
  248. 1580 IF PH<PG OR (PH>15 AND PH<32) OR (PH>63 AND PH<128) OR PH>255 THEN 1570
  249. 1590 PRINT LEFT$(V$,4)TAB(21)"[164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164]":PRINT TAB(21)"** TARGET PAGES **"
  250. 1600 LI=7:COL=24:LE=3:MSG$="[146]FROM PAGE:[146]":GOSUB 1700:PD=VAL(IN$)
  251. 1610 IF PD<13 OR (PD>15 AND PD<32) OR (PD>63 AND PD<128) OR PD>255 THEN 1600
  252. 1620 PE=PD+PH-PG:IF PE>255 THEN PE=255
  253. 1630 PRINTLEFT$(V$,9)TAB(23)"..TO PAGE:"PE
  254. 1640 IF PD>PG AND PD<=PH THEN 1670
  255. 1650 FOR I=PD TO PE:PRINT LEFT$(V$,12)TAB(12)"COPYING PAGE"I
  256. 1660 FOR J=0 TO 63:POKE I*64+J,PEEK((PG+I-PD)*64+J):NEXT:NEXT:PRINT "[147]":GOTO 170
  257. 1670 FOR I=PE TO PD STEP -1:PRINT LEFT$(V$,12)TAB(12)"COPYING PAGE"I
  258. 1680 FOR J=0 TO 63:POKE I*64+J,PEEK((PG+I-PD)*64+J):NEXT:NEXT:PRINT "[147]":GOTO 170
  259. 1690 END
  260. 1695 REM ****************************
  261. 1696 REM *                          *
  262. 1697 REM *      INPUT ROUTINE       *
  263. 1698 REM *                          *
  264. 1699 REM ****************************
  265. 1700 Y9=2:IN$="":UC=0:UB$=LEFT$(BL$,LE):GOSUB 1800:UB$=" ":UC=3
  266. 1710 UT=TI
  267. 1720 GET Z9$:IF Z9$="" THEN 1780
  268. 1730 IF Z9$=CR$ THEN Y9=2:GOSUB 1800:PRINT "[157][157] ":RETURN
  269. 1740 IF Z9$=DE$ THEN ON -(LEN(IN$)=0) GOTO 1780:IN$=LEFT$(IN$,LEN(IN$)-1):GOTO1780
  270. 1750 IF (ASC(Z9$)AND127)<32 OR Z9$=CHR$(34) THEN 1780
  271. 1760 IF LE=LEN(IN$) THEN 1780
  272. 1770 IN$=IN$ + Z9$
  273. 1780 GOSUB 1800:IF TI-UT<10 THEN 1720
  274. 1790 Y9=3-Y9:GOTO 1710
  275. 1800 PRINT LEFT$(V$,LI)TAB(COL-1)MID$(MSG$,Y9)UB$IN$MID$(" [146]",Y9,UC)" ";:RETURN
  276. 1805 REM ****************************
  277. 1806 REM *                          *
  278. 1807 REM *  CHECK FOR DISK ERRORS   *
  279. 1808 REM *                          *
  280. 1809 REM ****************************
  281. 1810 INPUT#1,A$,B$,C$,D$
  282. 1820 IF VAL(A$)=0 THEN RETURN
  283. 1830 PRINT"[147]DISK ERROR:[146] "B$
  284. 1840 CLOSE2
  285. 1850 END
  286. 1855 REM ****************************
  287. 1856 REM *                          *
  288. 1857 REM *  VIEW SPRITE IN MOTION   *
  289. 1858 REM *                          *
  290. 1859 REM ****************************
  291. 1860 POKE G+21,0:PRINT "[147]":POKE G+16,0
  292. 1870 X=INT(RND(1)*100)+155:Y=INT(RND(1)*100)+75:DX=4:DY=2:X2=0:Y2=0
  293. 1880 POKE G,X:POKE G+1,Y:POKE G+21,1
  294. 1890 B$=" ":X=X+DX:Y=Y+DY:GET A$:IF A$<>"" THEN 1950
  295. 1900 IF X>255 THEN X=255:DX=-DX
  296. 1910 IF Y>200 THEN Y=200:DY=-DY
  297. 1920 IF X<65 THEN X=65:DX=-DX
  298. 1930 IF Y<75 THEN Y=75:DY=-DY
  299. 1940 GOTO 1880
  300. 1950 IF A$="+" THEN DX=DX+SGN(DX):DY=DY+SGN(DY):DX=DX-(DX=0):DY=DY-(DY=0)
  301. 1960 IF A$="-" THEN DX=DX-SGN(DX):DY=DY-SGN(DY):DX=DX+(DX=0):DY=DY+(DY=0)
  302. 1970 IF A$="+" OR A$="-" THEN 1890
  303. 1980 IF A$="" THEN B=(B+1)AND15:POKE 53281,B
  304. 1990 IF A$="" THEN E=(E+1)AND15:POKE 53280,E
  305. 2000 IF A$=">" THEN C=(C+1)AND15:POKE G+39,C
  306. 2010 IF A$="" THEN X2=1-X2:POKE G+29,X2
  307. 2020 IF A$="" THEN Y2=1-Y2:POKE G+23,Y2
  308. 2030 IF A$=CR$ THEN POKE G+21,0:RETURN
  309. 2040 IF A$<>B$ THEN 1890
  310. 2050 GET B$:A$=B$:IF B$<>" " THEN 1980
  311. 2060 GOTO 1890
  312.